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BASSSUDF _WL 16-Sep-1984 01:23:41 AX-11 Bliss-32 V4.0-74 Page 1 L 
12-8601 382 91:83:03 BASRTL.SRCIBASUDFUL .B3 37 . (1) 1 
1 pon MODULE BASSSUDF _WL ( ! BASIC Write List Directed UDF la 
¢ si te = '1-077' ! File: BASUDFWL.B32 Edit:MDL1077 : 
4 0904 1 BEGIN ; 
5 0005 1! 3 
6 B08 1 eee R RRR AREA RREEERAAE EAA E ETE ATER ARETE eee a 
7 0007 1 !* . i 
8 0008 1 !* COPYRIGHT (c) 1978, 1980, 1982, 1984 BY * 3 
9 0009 1 '* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. . : 
19 got9 : ¢ ALL RIGHTS RESERVED. x 3 
'® * 3 
\ Bolg 1 !* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * 3 
1 0015 1 !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * : 
14 0014 1 !* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * ‘ 
15 0015 1 !* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * : 
16 p08 1 !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 3 
Bot? : .° TRANSFERRED. * 3 
'e * F 
19 0019 1 !* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * H 
20 0020 1 !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * : 
$ pos! : bs CORPORATION. * 3 
'e * 3 
23 $038 1 != DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * 3 
24 0024 1 !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ® 3 
25 0025 1 !« * 3 
26 0026 1 !« * ; 
e7 0027 1 VRE RARER EERE EERE AAR EEE EA AEA E ATER EERE AAA AAEER EERE a 
28 0028 1 3 
29 0029 1 !++ 3 
$ sits : FACILITY: BASIC Support Library - not user callable i 
32 0032 1 ! ABSTRACT: ; 
33 0033 1! 3 
$e sit : ENVIRONMENT: User access mode; reentrant AST level or not. : 
4 Boa6 : : AUTHOR: Donald G. Petersen; CREATION DATE: 17-Mar-78 3 
36 0038 1 ! MODIFIED BY: 
39 0039 1! : } 
40 0040 1 ! 0-14 = Store error in ISBSB_ERR_NO, don't signal it! JMT 14-Jan-78 ‘ 
41 0041 1! Donald G. Petersen, 17-Mar-78: Version 1-01 : 
42 0042 1! 1-01 = original i 
43 0045 1 ! 1-02 = Change to JSB linkage. DGP 14-Nov-78 
44 0044 1 ! 1-004 = Update copyrignt notice and add device names to REQUIRE i 
45 0045 1! files. JBS 29-NOV-7 i 
46 0046 1 ! 1-005 - Change LUBSB_PRINT_SIZ to LUBSB_R MARGIN. DGP 05-Dec-78 : 
47 0047 1 ! 1-006 - Change REQUIRE filé names from FOR... to OTS... JBS 07-DEC-78 i 
48 0048 1 ! 1-007 - Fix some failures to return values (new BLISS coun tier? and : 
49 0049 1! run through PRETTY to improve appearance, JBS_20-DEC-7 : 
50 0050 1 ! 1-008 = Add a longword entry point to WLl. DGP 27-Dec- i 
51 0051 1 ! 1-009 = Change one argument in call to BASSCNV_OUT G. DGP 03-Jan-78 : 
28 B36 1 ! 1-010 - Change references to ISB$A_BUF_BEG, BUF_END, and BUF_PTR to LUB. i 
5 0055 1! DGP 05-Jan-79 
54 0054 1 ! 1-011 - Change some constants to symbolics. DGP 10-Jan-79 ! 
55 0055 1! Hn 4 - Convert to CR format for data files. DGP 11-Jan-79 i 
56 0056 1 ! 1-015 = Fix a bug in Print string. DGP 16-Jan-79 
57 0057 1 ! 1-014 = Add a guard bit for AST reentrancy. DGP 20-Jan-79 
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18-5. $ep-1984 01:23:4 AX-11 i hee -32 v4.0-74 P 
aoe rae tt 7 on BASRTL. SRC IBASUDFUL B32: 1 age 45 


Correct a tyeo in edit 014. JBS 20-JAN-1979 
Change DO_WRITE to a Global routine BASSSDO_WRITE so that it can 
be called” : Bye module which does 1/0 Cleanup at the end of a 
rogram, Jan-79 
se atte addresses for externals. JBS 27-JAN-1979 
Change buffer overflow nanet ing in BASSSUDF_WL1. DGP 22-Feb-79 
Heke change to handling of strings longer than output buffer. DGP 


e 

Make LUBSB_PRINT <POS a lon word. DGP 19-Mar-79 

Fix a few Bugs in PRINT. 19-Mar-79 

Make another attempt to get” comme a working. 
0 


DGP 02-Apr-79 
sen'ggten Teraess tng didn’t check for overf i 


w of right margin. 


Scan. = TEx! not working properly for non-printing characters. DGP 
Fix an obscure error in SCAN_TEXT. DGP 12-Apr-79 
Change macro CHK_CUKSOR_POS fo GTR from GTRU. DGP 16-Apr-79 
Me 12 ecwars at least One space when updating printhead position. 
- re 

og Bak. ow print. pos to go less than 0 for backspace characters. 
Add support for CRLF te. fron Btsés g records DGP 25-Apr-79 
Remove Global attribute from ° S$$$D0_WRITE. P+ 10-May-79 
Change ISBSV_AST_GUARD to LUB ASI OBUARD. S$ 15-MAY-1979 
Make BASS$S$DO_WRITE global agin ta tors BASUDE WE. 8S GP 15-May-79 

Make the margin 16 bits. MAY-1979 
BASSSUDF _WLO noe initializes LUBSV_FORM_CHAR to 0. DGP 12-Jun-79 
Update LOBSA_BUF_PTR_in case where string is too long to fit in 
buffer. DGP”20- fs a 79 
Update LUBSA_BUF_PTR correctly if ae is tog long. DGP 26-Jun-79 
Use the new Conversion routines. DGP 28-Jun-7 
Check V_NOMARGIN and allow infinite margin if as DGP 11-Jul-79 
Check for buffer ag Aa A * well as right mar My DGP 15-Jul-79 
Allow Mat Print to uae Se REC level irae UE DGP 08-Aug-79 
Remove pe jOUiLTIN CTUALCOUNT. DGP 04-Sep-79 
PRINT F del for longword integer. DGP 7 ee 
Debug CRLF delimiting a record. OGP 23-Sep-79 
fiear LugstP RINT_POS for Mat Print if no format character. DGP 

c 

Clear ISB$V a PRINT. DGP 05-Oct-79 
Make UDF9 dispatch to the REC eee DGP 12-Oct-79 
Try again to get ‘CRLF* to delimit a record. DGP 15-Oct-79 

Fix bug in pr recing, long strings. The pointer was not moving through 
ics string. Also, leave the cursor coy it lies after each Little 

e 


piece of co Bass string. DGP 01-Nov- 
ass one arg to “y $0 90 WRITE to rene: od whether to put out 
rye 6-Nov-7 


edit Ty &. proper reposting. of LUBSL_PRINT_POS in 
Bas$$00.u WRITE; fix same. DGP 08-Nov-79 
U OBcNov gglunns 10-15 in the translation table in SCAN_TEXT. DGP 
Bon t update LUBSA_BUF_PTR im CHK_CURSOR_POS macro. DGP 09-Nov-79 
eae a the scale factor from the ISB. BGP 15-Nov-79 

F* is detected to break a record and wey are the last two 
characte 5 + in the record, then as t put out a following null record. 
Set 1sB3V PRINT_ INI in WLO and clear it if WL1 is called. DGP 04-Jan-80 
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Yocond it tonal ty initialize LUBSV_OUTBUF_DR to 1 in WL1. DGP 07-Jan-80 

ALL Calls to BASSSDO_WRITE write an entire record. DGP 14-Jan-80 

Bug iin yg UG | semicolon formatting that exceeds the left 

n. -Dec- 

1-059 - PRINT ing a record to the terminal longer than the buffer size inserts 

an extra CRLF. DGP 15-Feb-80 

1-060 - The macro CHK_CURSOR_POS gid not count LF as one character position. 

It does now. DGP 18-Feb-80 

1-061 = Correction to edit 1-060. LF should never count as a character 

osition. DGP 19-Feb- 

1-062 = The macro CHK_CURSOR_POS gets in infinite loop when it is trving 
RR point the margin was exceeded. Correct this. 


1-063 - Feit ieoee introduced another problem with the buffer pointer. 
x Ss. 
1-064 = The case of exceeding the right margin for terminal output with the 
first element of a Print statement which follows a Print statement that 
ended in a semicolon or comma causes the element to be printed twice. 
Fixed. DGP 01-Mar-80 
1-065 = Do not unconditionally reset LUBSV_FORM_CHAR in WLO. This is a 
belated finish to edit 55 to fix a bug. DGP 07-Mar-80. 
1-066 - In SCAN_TEXT, when checking for CRLF and last character encountered 
in the Buffer is a CR, don’t look beyond the buffer for the LF. 
REJ 05-May-80 
Put in the fix for checking Last print zone properly. 
LLELEM_ SIZE is set to zero in MACRO CHK_PRINT_ZONE, and the value 
of BASSK_COND_SUC in BASPAR.MAR is set fo 2 in place of 3. FM 19-SEP-80 
1-068 - Put in the fix for erewing out the next integer or floating number 
when the buffer is full. FM 25-SEP-80 


1-069 - Let ho hal 1-065A, did not quite fix the problem, so try again. 
1-070 = Lines with tabs were not oot properly if the Line exceeded 
the margin. Fix CHK_CURSOR_POS and SCAN_TEXT to count 
tab print positions properly, and SCAN TEXT now updates 
the_buffer pointer to keep pace with the print position. 
PL 30-Jun-81. 
- Add support for G &H. PL 21-Aug-81 
1-072 = Add support for packed decimal. PL 5-Oct-81 
- More edits for packed decimal. PL 6-Jan- ; 
- BASSSUDF_WL1 should call BASSCVT_OUT_P_G to format packed strings, 
instead Of BASSCVT_P_T. PLL 28-Jan-82 
1-075 - Fix a bug in packed = BAS$SCVT_OUT_P_G way deallocate and 
reallocate the dynamic output string. PLL 4-Mar-82 — 
1-076 - im BASSSUDF _WLO, load BUF_PTR from RBUF_ADR. This fixes a re-entrancy 
problem, MDL 10-May-1983 
1-077 = don't allow string elements to be split across lines when /ANSI. 
modify CHK_CURSOR_POS accordingly. MDL 5-Jul-1983 
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BASSSUDF _WL hes Sep-1984 01: AX-11 Bliss-32 V4.0-74 Page 4 
1-077 14-Sep etsy 9 83:4 EBASRTL SRCIBASUDFUL .B3 31 . (2) 
167 166 7 
168 O16 1 ! SWITCHES: 
150 o169 1. 
1%¢ 0170 : SWITCHES ADDRESSING _MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 
17 0172 1! 
174 grag 1 ! LINKAGES 
148 S78 1 
199 0176 1 REQUIRE ‘RTLIN:OTSLNK'; ! define all Linkages 
eR 
180 0607 1 ! TABLE OF CONTENTS: 
BL 
183 0610 1 FORWARD ROUTINE 
184 0611 1 BASSSUDF _WLO : JSB_UDFO NOVALUE, ! initialization 
185 0612 1 BASSSUDF_WL1 : CALC_CCB NOVALUE, ' format one user 1/0 List element 
186 061 1 age “Wl9 : > OpF9 NOVALUE. ! end of user 1/0 List = finish 
187 0614 1 SCAN_TEXT : CALL_CTB, ! Scan text string for special characters 
4 B612 } BASSSDO WRITE : JSB_DO_WRITE NOVALUE; ! Output routine 
190 0617 1 BUILTIN 
191 0618 1 CVTPS, ! Escape to MARS CVTPS instructions 
138 0619 1 CVTLD, ! Escape to MARS CVTLD instruction 
19 0620 1 MOVTUC; ' Escape to MARS MOVTUC instruction 
198 0652 1: 
196 0623 1 ' INCLUDE FILES: 
198 0638 1. 
MD pore ; REQUIRE ‘RTLML:BASPAR'; ! Intermodule BASIC parameters and constants 
$e! oat? : REQUIRE "RTLML:OTSISB’; ! 1/0 statement block (ISB) offsets 
208 444 : REQUIRE ‘RTLML:OTSLUB'; ! Only needed to get LUB Length! 
Son 9923 ' REQUIRE ‘RTLIN:OTSMAC'; ! Macros 
Soe 1326 ’ REQUIRE ‘RTLIN:RTLPSECT'; ! Define DECLARE_PSECTS macro 
$09 1250 1 LIBRARY ‘RTLSTARLE'; ! STARLET Library for macros and symbols 
ee 
312 1588 1 ! EQUATED SYMBOLS: 
1 1388 1° 
15 1386 1 LITERAL 3 
16 1257 1 K_FIELD_SIZE = ! print zone size 
13 1588 1: 
19 1260 1 ! MACROS: 
At 1562 1° 
$§ 1368 1 MACRO 
2 1264 1 
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+ 

If the format character is a comma, see if a full Fag zone remains 
in the record. If a full print zone is not available, then return a 
zero; else return a one. 

Note: this macro is only executed if the conversion or scan routine 
_returned @ success status. 


CHK_PRINT_ZONE = 
CCBCLUBSA_BUF_PTR] = .CCBCLUBSA_BUF_PTR] + .DSCCDSC$W_LENGTH); 
ar FORMAT_CHAR EQL BASS$K_COMMA_FOR 


CCBLLUBSA BUF PTR] = ie f END “a * 


(IF fnew eerie UF _END c(B CLUBSA_BUF_PTR] GTRU K_FIELD_SIZE 
pepD SI (.CCB CLUBSL_PRINT_ POS] MOD K-FIELD-SIZE) 
Kote LOBSA BUF END] = .CCB ~[LuBSR. BUF _PTRJ)> 


besa _BUF_PTRIJ; 
ccOrLiBst “PRIN NT puede CCBCLUBSL_PRINT POS] + K. -FIELD_SIZE - 
a . CCBCLOBSL “PRINT “Poss MOB K_FIELD_SIZE) 


'¢ 
i Check for a format character and that the right margin isn't 
a infinite. 


IF .FORMAT_CHAR EQL BASSK_COMMA_FOR 
a FORMAT_CHAR EQL BAS$R_SEMI_FORM 


N 
BEGIN 
IF ((.CCBCLUBSL_PRINT_ POS) LEQU .CCBCLUBSW_R fag ind) OR .CCB CLUBS$V_NOMARGIN]) 
amp 6.00 CCBCLUBSA_BUF _PTR) LEQU . CCBLLUBSA _BOF-ENDJ 


' 

! If this is a comma format, check to see if there is a full 

' print zone lef on the Line. If this is a semi-colon, this 

' check is redundant, but the code is applicable so what's a 

! Little redundancy? 

! If it does then return success. If it doesn't, return failure 
! without resetting the pointers so that this item will be 
written, 


M_SI12 0; 
haz: F ups. PRINT POS) + 
IF B OMMAT CHAR EGL BASSK_COMMA_FOR THEN K_FIELD_SIZE 


LEQU .CCB CLUBSW_R_MARGIN]) OR .CCB CLUBSV_NOMARGIN)) 
BAS$K_SUCCESS 


ELS 
BASS$K_COND_SUC 
END 


K 1 
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ELSE 


The comma causes this field to overflow the ge margin 
Check to see if there is lg else in the buffer. If 
there is, reset the pointers to before this element; if 
nothing else in the buffer, return a success status 

Or, a semicolon format caused the field to overflow past 
the buffer. Save this one for the next record. 

Check for the cursor position not being 0 prior to this 
element ‘cuz there could have been a series of statements 
—s in comma or semi and if this is a terminal device, 
then the data is PUT at each IO_END and the buffer doesn’t 
appear dirty although the print Line is. 


IF ;,CCBCLUBSV_OUTBUF_DR1 OR (.SAV_PRINT_POS NEQ 0) 


WINN 


SSIES EES SY REESE TS 


BEGIN 
DSCCDSC$W_LENGTH] = 0; 
CCBCLUBSA~BUF_PTR] = .A_SAV_PTR; 


ee ee a ee em ee ee ee ee ed ed od = 


MACRO 
: check the present cursor position against the desired print size. 
! Due to the possibility of having carriage contro} characters in 
' the output the data stream, the cursor position is used to check 
! the end of the record rather the number of characters in the record. 


a em a a ed ed od = = = = 


— . - —_. 
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4 te 
34 ! If the buffer was overflowed, then leave the cursor where it was; if the margin 

3 ns overflowed, then start a new record. 

o” 34 , IF (NOT .CCB CLUBSV_NOMARGIN]) AND (.CCB CLUBSL_PRINT_POS] GTRU .CCB CLUBSW_R_MARGIN 
i 3 BASSK_MAR_EXC 

11 : BASS$K_BUF _EXC 
312 3 D 
313 3 
314 35 BEGIN 
315 35 CCBCLUBSA_BUF _PTR] = .CCBCLUBSA_BUF_BEG] + .DSCCDSC$W_LENGTH); 
316 3 FORMAT_CHAR ="BAS$K_SEMI_FORM; 
HEA ; - L_ELEM_SIZE = 0; 
319 36 i If the buffer was overflowed, then leave the cursor where it was; if the margin 
359 $0 overflowed, then start a new record. 
$23 Ha IF (NOT .CCB CLUBSV_NOMARGIN]) AND (.CCB CLUBSL_PRINT_POS] GTRU .CCB CLUBSW_R_MARGIN 
$¢ 3 BASSK_MAR_EXC 

26 36 BASS$K_BUF _EXC 

$i 36 D 

8 END 

$3 37 ELSE 

i; ‘end of macro 

34 

se 
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8 1379 #1 !- 
9 1380 1 
40 ™ 1381 1 CHK_CURSOR_POS = 
ry . : § } ss -CCB CLUBSV_NOMARGIN]) AND (.CCBCLUBSi_PRINT_POS] GTR .CCBCLUBS$W_R_MARGINI) 
4 “1 se 1 ¢ 
44 ™ 1585 1 ! The cursor position has exceeded the print size. 
45 41 38 1 ' Restore the pointers back to where they were before the 
46 m 1387 1 ' Last MOVTUC. 
47 m 1388 #1 le 
48 m™ 1389 1 
49 m 1390 1 BEGIN 
50 m 1391 #1 RET_VAL = BASSK_MAR_EXC; 
51 “1 3 1 
25 ™ 1393 1 + : 
5 M1394 1 ! Reset a few pointers (use the fact that the data is al- 
54 M1395 1 : rqaey in the destination field) and find out the length 
55 M1396 1 ! of the string which fits within the right margin. This 
56 ™ 1397 1 ' requires looking at each character individually. 
357 m 1398 1 le 
358 m 1399 1 
$2 ™ 1400 1 CCBCLUBSL_PRINT_POS] = .L_SAV_PRINT_POS; 
60 M1401 1 CCBCLUBSA_BUF _PTrR) = .A_SAVE Bur PTR; 
361 4 1498 1 T_DSCCDOSCSW_LENGTH] = .C_SAVE_LENGTH; 
¢ m 1403 1 
™ 1404 1 1+ 
m 1405 1 : if ANSI, then get out - we don't split string elements 
365 ™ 1008 1 ' across lines. 
706 Mm 140 1 le 
7 ™ 1408 1 IF .CCB CLUBSV_ANSI] THEN EXITLOOP; 
368 ™ 1409 1 
369 ™ 1410 1 WHILE .CCBCLUBSL_PRINT_POS] LSS .CCBCLUBSW_R_MARGIN] 
3/0 ™ 1411 #1 DO 
71 ™ 16 1 BEGIN 
36 - rot : CCOLLUBSL PRINT POS) = (SELECTONE .(.CCBCLUBSA_BUF_PTR])<0,8,0> OF 
74 m1415 1 K_TAB]: (.CCBCLUBSL_PRINT_POS] OR K_TAB_LIT) + 1; 
75 m1416 1 K_CRJ: 0; 
76 M1417 1 K_BKSP): MAX(O, .CCBLLUBSL_PRINT_POS] = 1); 
377 m1418 1 K BLANK TO K_TILDE): -CCBCCUBSL_PRINT_POS) + 1; 
78 m 1419 1 OTHERWISE]: [CCBCLUBSL_PRINT_POS) + 0; 
My M 1o69 1 TES); 
80 M1421 1 CCB CLUBSA BUF PIR} = .CCB CLUBS$A_BUF PTR] + 1; 
81 ol 1656 1 T DSCCOSCSQ_LENGTH) = .T_DSCCDSCSO_LENGTH] + 1; 
a " ¢ 2 : END; ! While Toop 
+ 
84 M1425 1 ! Restore the buffer pointer so that it can be incremented properly by the 
H : i? $ : code that does the common output stuff. 
87 M1428 1 CCB _CLUBSA_BUF_PTR] = .A_SAVE_BUF _PTR; 
68 m 1429 #1 EXITLOOP; 
89 ™ 1430 1 END; 
90 1431 12%; 
91 14 § 1 
3 14 1! 
9 1434 1 ! PSECT DECLARATIONS: 
94 1435 1! 


mM 1 
BASSSUDF _wWL 16-Sep-1984 01:23:4 AX-11 Bliss-32 V4.0-74 Page 8 
ts 2 12286871382 te 6:4 EBASRTL-SRe BASUDF WL .B832;1 . (2) 
95 1% $ ! DECLARE PSECTS (BAS); ! declare PSECTs for BASS facility 
3 14 § { OWN STORAGE: 
oy 
401 144g i EXTERNAL REFERENCES: 
04 A cg 
'¢ 
ont 1309 ! Array of REC9 routines 
<0? ie : BASSSAA_REC_PRO : VECTOR; 
409 1450 1 EXTERNAL ROUTINE é : 
410 1451 1! The following are general Library routines available for any 
411 1028 i: one’s use (value is true if fits in field): 
tig 14535 1 BASSCVT_OUT_H_G, ' Convert H float to G format 
41 1454 1 BASSCVT_OUT_H_E, ! Convert H float to E format 
414 1455 1 BASSCVT_OUT_G_G, ! Convert G float to E or F 
415 1456 1 BASSCVT_OUT_D_G, ! Basic G (E or F) output conversion 
416 1457 1 CVT PG, ! Convert packed to G format 
417 1458 1 BASSSREC_WSCO™: JSB_RECO NOVALUE, ! initialize List directed output 
418 1459 1 BASSSREC_WSL1 : JSB_REC_WSL1 NOVALUE, ! write list directed 
419 1460 1 BASSS$REC_WSL9 : JSB-REC9 NOVALUE, ! end list directed output 
420 1461 1 BASSSREC MPR1 : JSB_REC1 NOVALUE, ! Mat Print REC Level 
421 be | 1 STRSAPPERD, ! append a string PR 
422 14635 1 STRSDUPL_ CHAR, ! create a string of specified char 
423 1464 1 STRSFREET_DX, ! deallocate dynamic string 
$s¢ eH ' LIBS$STOP = NOVALUE; ! signal an error 


ee 
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te 1378eb= 188s 918854 BASRTL SRE IBASUDFUL 039; 1 “oa 
: 627 1467 1 GLOBAL ROUTINE BASSSUDF _WLO ! Write List directed UDF initialization 
: 428 1468 1 : JSB_UDFO NOVALUE = 

: 2% 1090 | tes 

: 431 pea FUNCTIONAL DESCRIPTION: 

; : : 1278 : Initialize PRINT User data formatter (UDF) 
t ‘ 5 1475 FORMAL PARAMETERS: 

i tea 

; 439 1474 } j IMPLICIT INPUTS: 

+ 661 1481 1! LUBSV fs} GUARD Guard bit for AST reentrancy 

: rk 1088 ; LUBSA_BUF _PTR Pointer to next byte in user buffer 

; 444 14684 IMPLICIT OUTPUTS: 
3 646 1486 1! LUB$V_AST_GUARD Guard bit for AST reentrancy 

3 467 1487 1: LUBSA_BUF _BEG Pointer to first byte of user buffer 

3; 448 1488 1! LUBSA_BUF PTR Adr of next byte of output 

3; 449 1489 1! data buffer 

3; 450 1490 1: LUBSA_BUF END Adr of end of data buffer 
3 tt red ! ISB$V~PRIAT_INI indicates that a PRINT has been initialized 
> 45 1298 1 ' ROUTINE VALUE: 

3 6656 1494 1 ! COMPLETION CODES: 

3 «6455 1495 1! 

Boe Bt om 

: 458 1498 1 | SIDE EFFECTS: 

; 659 1499 1! 

; 460 1500 1: NONE 

: 661 1501 1! 

: 46 1208 1 i- 

; 46 1503 1 

: re} 1308 2 BEGIN 

; 466 1506 EXTERNAL REGISTER 

3; 467 1507 CCB : REF BLOCK C, BYTE); 

: 086 1809 

: 470 1510 hs guard bit is used to ensure AST coonerancy, The bit is set to 1 

: «471 1511 ' at the top of the routine. tested for 1 at "7 bottom of the routine 
ee, 1318 i and set to 0 upon exitti ng. If the test for 1 fails at the bottom of 
ls 67 151 i the routine, then an AST has gone off and used this routine possibly 

3 476 1514 i chan ing the buffer pointers. Therefore this routine will loop back and 
: 475 1515 ! run itself again in its entirety. 

; 476 1218 ie 
ls 677 151 
3; 4678 1518 DO 

; 679 1519 BEGIN 
rari 1334 ts 
> 468 15 é ' Set the guard bit 
is 68 15 ie 
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CCB CLUBSV_AST_ GUARD] = 1; 


'¢ 
Call record level to get buffer pointers. 


BASSSREC_WSLO (); 


'¢ 
set the beginning of the buffer if there is no format character pending 


IF_NOT .CCB CLUBSV_FORM_CHARJ 
THEN 


BEGIN 
CCB CLUBSA_BUF_PTR] = .CCB CLUBSA_RBUF_ADRI; 
CCB CLUBSA-BUF-BEG] = .CCB CLUBSA~BUF_PTRI; 


'¢ 
! Set the print initialized bit. The null print Line (10 PRINT) 
! does not have an element transmitter (compiler optimization). So, 

: rhe bit is set here and then can be cieared by element transmitters 
: any. 


le 

CCB CISB$SV_PRINT_INIJ = 1; 

'¢ 

: Check the guard bit. If it is now 0, then an AST has gone thru this routine 
. Since the data base e! have been altered in an unpredictable manner, it 
. e 
' 


is necessary to redo the entire routine. Note: in worst case processing, 
the run-time for this routine is essentially unbounded. 


END 
UNTIL .CCB CLUBSV_AST_GUARD]; ! End of AST guard loop 
CCB CLUBSV_AST_GUARD] = 0; 
END; 
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GLOBAL ROUTINE BASSSUDF_WL1 (ELEM_TYPE, ELEM_SIZE, ELEM_ADR, FORMAT_CHAR 
) : CALL_CCB NOVALUE = 


++ 


FUNCTIONAL DESCRIPTION: 


Write List-directed User Data Formatter. 
Accept an 1/0 element, format it, and put it in the record buffer. 
Calls record level processors to perform the actual 1/0 if the buffer 


is full or if non-forcible and end-of-record (no format character). 
i FORMAL PARAMETERS: 


ELEM_TYPE.rlu.v data type of the eLement 

ELEM_SIZE.rlu.v size of the data element 

ELEM_ADR.riu.r adr of the data element to be written 
Points to a descriptor for string 


i IMPLICIT INPUTS: 


LUBS$V_AST_GUARD 


guard bit for AST reentrancy 
LUBSL~PRINT_POS 


current cursor position 
LUBS$V_OUTBUF _DR indicates valid data in the output buffer. 
LUBSW_R_MARGIN size of buffer specified in OPEN statement. 
LUBSV_FORM_CHAR flag that a format character (‘,' or ';') was 
seen on *he Last element. 


—m 


BASRTL.SRCJBASUDFWL.B32;1 
! format character 


s 
FORMAT_CHAR.rlu.v type of format character which followed the data element 
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LUBSA_BUF _BEG 
LUBSA~BUF ~PTR 
LUBSA~BUF ~END 


IMPLICIT OUTPUTS: 


1SB$V_PRINT_INI 


ROUTINE VALUE: 
COMPLETION CODES: 


NONE 


SIDE EFFECTS: 


pointer to beginning of user buffer 
pointer to current position in the buffer. 
pointer to last byte of buffer + 1. 


reset print intialize flag - there is at least one 
element transmitter 

quere bit for AST reentrancy 

ndicates valid data in output buffer 

flag to indicate a format character was seen 
internal cursor position. 

next byte in the user buffer 


If an AST goes off while we are in this routine and calls this routine, 
then this routine will be repeated. It will continue to be repeated 
until there are no more ASTs using this routine. 


BEGIN 
EXTERNAL REGISTER 


pon 
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> 584 1623 CCB : REF BLOCK C, BYTE); 
: 585 1624 
ls 2n6 1625 MAP 
3 Hh § ELEM_ADR : REF VECTOR; ! element is call-by-reference 
E 250 6 5 a PTR ' int int tri bei inted 
; ! pointer into string being printe 
; 591 1630 L_ECEM_S1ZE, i femp for ELEM SIZE for strings 
3 236 1631 ' in case a string is longer than the buffer 
gh.. 16 ; A_SAV_PTR, ' temp for saving LUBSA_BUF_PTR 
; 594 163 P ' temporary character string pointer 
: 595 1634 DirF, i number of bytes left in record buffer 
; 596 1635 DSC : BLOCK (8, BYTE) ! static string descriptor for output field 
: 597 1636 TEMP_DEC_DSC : BLOCK (8,BYTE); i place to store converted decimal 
; 598 1637 ! string 
; 599 1638 LITERAL ; 
; 600 1639 K_FIELD SIZE = 14 ! Maximum size to be used by output conversion routine 
; 601 1640 K-TEMP_BuF_S1Z = 14; 
; 602 1641 
; 6035 4 2 ‘+ 
> 604 16435 2 ! This loop is to ensure AST reentrancy. 
; 605 1644 2 te 
; 606 1645 2 
; 607 1646 ¢ DO 
; 608 1647 BEGIN 
; 609 1648 : CCB CLUBSV_AST_GUARD] = 1; 
; 610 1649 STR_PTR = 0; 
> 611 1650 3 !+ 
3 org 163) 3 Reset the print initialize flag; there is at least one element transmitter. 
3; 614 1688 : CCB CISB$V_PRINT_INIJ = 0; 
3; 615 1654 3 L_ELEM_SIZE = .ECEM_SIZE; 
; 616 1655 3 
s 67 1656 ; '¢ 
; 618 1657 ! convert or move the field directly into the output buffer with 
; 619 1658 3 ' the exception of the numerics using G format. 
; 620 1659 3 le 
s Oe 1660 3 
; Ose 1661 3 DSC CDSCS$B_DTYPE] = 0; 
; 62 1066 3 DSC CDSC$B_CLASS) = 0; 
3 624 166 3 DSC EDSCSWILENGTH) = 0; 
3 629 1664 
; 626 1665 3 '¢ ; 
; 627 1666 ! save the current pointer in the buffer 
: 628 1667 ! Only needed the first time thru the loop 
3 66° 1668 te 
; 630 1669 
: 631 1670 A_SAV_PTR = .CCB CLUBSA_BUF _PTR]; 
; O34 1671 
3; 3 1676 '¢ / - 
3; 634 167 ! determine the length of each field taking into account the format character. 
; 635 1674 ! In addition to the length, condition the bit which indicates the 
5.6 1675 ' presence or absence of a format character. 
: 637 1676 !e 
; 638 1677 
; 639 1678 CASE .FORMAT_CHAR FROM BASSK_SEMI_FORM TO BASSK_NO_FORM OF 
: 640 1679 SET 
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(: 64] 1680 

H org 1681 CBASSK_SEMI_ FORM) : 

3 64 1986 CCB CLUBSV_FORM_CHAR] = 1; 

; 644 168 

; 645 1684 CBASSK_COMMA_FOR] : 

; 646 1685 CCB CLUBSV_FORM_CHAR] = 1; 

; 647 1686 

> 648 1687 CBASS$K NO FORM) : 

; 649 1688 CCB CCUBSV_FORM_CHAR] = 0; 

; 650 1689 $3 

; 651 1690 

; 626 1691 

; 65 1696 IF .ELEM_TYPE EQL DSCSK_DTYPE_P THEN 

; 654 1695 4 BEGIN 

8 639 1694 4 

; 656 1695 4 ‘+ 

; 657 1696 4 : Convert packed decimal string to text so that it can be handled 

; 658 1697 4 ! in the same way as text. Can't convert it in it's own space so 

; 659 1698 4 ' copy to a temporary area. 

; 660 1699 4 te 

; 661 1700 4 

>; 66 1701 4 LOCAL 

>; 66 p44 4 STATUS; 

> 664 1703 4 

; 665 1704 4 TEMP_DEC_DSC (CDSCSB_CLASS] = DSCS$K_CLASS_D; 

> 666 1705 4 TEMP_DEC_DSC LDSCS$B_DTYPE] = DSCSK_DTYPE_T; 

; 667 1706 4 TEMP_DEC_DSC [LDSCSA_POINTER] = 0; 

3 8 170e : TEMP_DEC_DSC CDSCSW_LENGTH] = 0; 

: 670 1709 4 STATUS = (BASSCVT_OUT_P_G (.ELEM_ADR, 0, L_ELEM_SIZE, TEMP_DEC_DSC)); 

5 of) 1719 : IF NOT .STATUS THEN LIBSSTOP (.STATUS); 

3 673 1712 3 END; ! end of packed conversion 

; 674 1713 ; 

; 675 1714 '¢ 

: 676 1715 3 : This WHILE Loop will repeat as often as necessary to put out the entire 

; 677 1716 3 : field. If a field will not fit into the buffer currently it is 

; 678 1717 : important to note whether there is anything in the buffer to begin with. 

: 679 1718 3 ! If there is then the buffer pointer is set to the value it had when : 

; 680 1719 3 : this routine was entered. Then the buffer is dumped. If there is nothing 

; 4681 1720 3 : in the buffer, then the assumption is that this is a string that is too 

; 682 1721 3 ! Long to fit into the buffer and must be written in sections. The String 

; 683 Hs : is left in the buffer and the buffer is dumped. The loop is then repeated 

3: 684 7s ! until the whole string has been dumped. The key to control is the flag 

; 685 1724 ' LUBSOUTBUF _DR. 

; 686 1725 te 

3; 687 1726 

; 688 1727 WHILE 1 DO 

; 689 1728 4 BEGIN 

; 690 He 9 4 

; 691 1730 4 L ; : 

: 692 1731 4 WRITE STATUS, ! status returned from the conversion routines 

; o37 1736 ? SAV_PRINT_POS; ! Temporary to save the current cursor position 

3; «695 1734 4 SAV_PRINT_ POS = .CCB CLUBSL_PRINT_POS); 

; 636 1739 ‘ DSC” CDSCSA_POINTER) = .CCB CLUBSA~BUF PTR; 
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; 635 1738 d i* pert h i 

3 ! Perform the appropriate conversions. 

: $86 1739 ¢ i (Poss 

; re 1740 4 

: 20 1741 6 IF NOT (WRITE_STATUS = (CASE .ELEM_TYPE FROM DSCSK_DTYPE_B TO DSCS$K_DTYPE_H OF 

: 704 1408 6 DSCSK_DTYPE_B,DSCSK_DTYPE_W, DSCSK_DTYPE_LJ : 

3 £09 1744 6 

; 109 128 4 tape 4 d or L d. Pri i 

; ! Type integer - word or longword. Print out as integer 

; 708 1709 6 : aivays or tar as F format. . 

; 709 1748 6 !< 

; 710 1749 8 

ee ay 1750 BEGIN 

3 Ne 1751 7 

s ft 1736 7 LITERAL 

> 714 1753 7 K_NUM_DIGITS = 10; 

s 715 1754 7 LOCAL 

; 716 1755 7 RET _LENGTH, ! Length returned by conversion routine 

; ah 1736 4 D_VALUE : VECTOR (2); ! holds double precision floating value 
3; 719 1758 8 DSC COSCS$W_LENGTH] = (IF .CCB CLUBSA_BUF_END] - .CCB CLUBSA_BUF_PTR] GTRU 
; 720 1759 8 K_FIELB_SIZE 

3 ey 1760 8 

3 fee 1761 8 te 

3 «fee 1786 8 ! Convert the integer value to a double precision value in 

3; 726 1765 8 ! preparation for calling BASSCVT_OUT_D_G 

3 fe 1764 8 te 

; 726 1765 8 

s ver 1766 7 THEN K_FIELD_SIZE ELSE .CCB CLUBSA_BUF_END] - .CCB CLUBSA_BUF_PTR)); 

3 rss 17er y CVTLD TELEM_ADR CO], D_VALUE (0]); 

: 730 1769 7 IF BASSCVT_OUT_D_G (D_VALUE, 0, RET_LENGTH, DSC, 0, K_NUM_DIGITS) 

3. my 1770 7 THEN 

; rm 1771 8 BEGIN 

3; 733 1776 8 L_ELEM_SIZE = 0; 

; 734 1773 8 DSC COSC$W_LENGTH) = .RET_LENGTH; 

: 735 1774 8 CCB CLUBSL-PRINT_POS] = .CCB CLUBSL_PRINT_POS] + .DSC COSCS$W_LENGTH); 
3; re 1775 8 CHK_PRINT_ZONE 

> wae 1776 8 END 

; 738 1777 7? ELSE 

; 739 1778 7 BASS$K_BUF _EXC 

; 740 1779 7 

; (741 1780 6 END; 

> 74 1781 6 CDSCSK_DTYPE_F, DSC$K_DTYPE_D) : 

3; 74 178s 7 BEGIN 

3: 744 1783 7 

: 745 1784 7 LOCAL ; : 
; 746 1785 7 RET _LENGTH, ! hold the length returned by conversion routine 
$ oH 1786 D_VALUE : VECTOR (2); ! holds double precision floating value 
3 749 1788 : DSC CDSC$W_LENGTH) = (IF .CCB CLUBSA_BUF_END] - .CCB CLUBSA_BUF _PTR] GTRU 
3; 750 1789 K FI LO si2g THEN K FIELDSIZE ECSE [CCB CLUBSA_BUF_ENDJ - [CCB CLUBSA_BUF _PTR]) 
3: 751 1790 7 D_VALOE = .ELEM_ADR CO); 

: 3 i”) 4 D_VALUE (1) = (IF -ELEM_SIZE EQL %UPVAL THEN O ELSE .ELEM_ADR (1)); 

: 754 1798 7 IF BASSCVT_OUT_D_G (D_VALUE, 0, RET_LENGTH, DSC, 
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E ? 5 : yi -ELEM_SIZE EQL %UPVAL THEN O ELSE .CCB CISBSB_SCALE_FACJ)) 

7 $ BEGIN 

758 L_ELEM_SIZE = 

759 DSC COSC$w_ tentiu) «RET T LENGTH 

760 CCB CLUBSL~PRINT "POS) = CCB CLUBSL _PRINT_POS] * .DSC COSC$W_LENGTHI; 

761 CHK_PRINT_ZONE 

76 END 

76 ELSE 

764 BASSK_BUF _EXC 

i . 

res cosc$n gbTvPe.c3 : 

768 BEGIN 

769 

770 LOCAL 

771 RET LENGTH ‘Length retd by conversion routine 

77 VALUE : VECTOR (2): tholds G floating value 


DSC CSCS LENGTH] = (IF CCB CLUBSA BUF_END] = CCB CLUBSA BUF_PTRI GTRU 
¢_VALOE fb EO _SIZE TwEN cig SIZE ECSE 7¢CB CLUBSA_BUF_END] = 7CCB CLUBSA_BUF_PTR]) 


e- VALUE fF ELEMS ADR RFS 
IF me (G_VALUE, 0, RET_LENGTH,DSC) 


ten 
L_E 
bse” Fosesa ate er »RET LENGTH: 
CCB PUBSL PRINT Pos] = .CCB CLUBSL _PRINT_POS] + .DSC CDSC$W_LENGTH); 
CHK_PRINT_ZONE 
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787 ELSE 

788 BASSK_BUF _EXC 

789 END; 

790 CDSC$K_DTYPE_H) : 

791 BEGIN 

9 

794 Aber LENGTH, ‘Length retd by conversion routine 

a4 H F VALUE : VECTOR (4); ‘holds H floating value 

797 DSC erie gtENGTH = (IF .CCB CLUBSA_BUF_END] - .CCB CLUBSA_BUF_PTR] GTRU 
798 37 i mee K rfbhs LD_SIZE ECSE [CCB CLUBSA_BUF_ENDJ - [CCB CLUBS BUF _PTR]) 
799 38 H_ VALCO “= .ELEM_A ; 

800 39 H ~VALUE —— LERCADR ; 

801 40 H~ VALUE } = .ELEM"ADR ; 

80 41 H~ VALUE = .ELEMZADR : 

804 rk IF BASSCVT_OUT_H_G (H_VALUE, 0, RET_LENGTH, DSC) 

805 44 THEN 

is 3 se 

808 “3 DSC Heat eatin 6 =_ RET T LENGTH 

809 48 CCB SL-PRINT_POS) = .CCB LUBSL _PRINT_POS] + .DSC CDSCS$W_LENGTH); 
Hf ine 
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; 8 1851 7 ELSE 

; i$ 1880 i 1° BASSK_BUF _EXC 

; 815 1854 6 CoscSk BTYPE.t, DSCSK_DTYPE_P] : 

: 816 1855 6 

2 ne Peant or veces secon 

; ! text or packed decima 

: 819 1858 6 i : 

; 820 185 § 

; 821 1860 BEGIN 

; 8 ¢ 1861 7 OCAL 

; & 186¢ 7? SRC_LOC ! source text location 

> B24 1863 7 SCAR_STATUS; i status returned by SCAN_TEXT 
; $s? 1864 7 

; 826 1865 7 '¢ 

3s Ger 1866 7 ' Packed decimal has been converted to text and stored in 
; 828 1867 7 : a temporary descriptor. SCAN TEXT must move from this 
; 562 1868 7 ! temporary area to the destinalion descriptor, instead of 
; 830 1869 7 ! moving from ELEM_ADR. 

; 831 1870 7 te 

; S36 1871 7 

; 83 1878 7 IF .ELEM_TYPE EQL DSC$K_DTYPE_P 

; 834 1873 7 H 

; 835 1874 7 SRC_LOC = .TEMP_DEC_DSC CDSCSA_POINTER] 

; 836 1875 7 ELSE 

; 837 1876 7 SRC_LOC = .ELEM_ADR (1); 

; 838 1877 7 

; 839 1878 7 IF SCAN_STATUS = SCAN_TEXT ((.SRC_LOC + .STR_PTR), .L_ELEM_SIZE, 
; 840 1879 7 -CCB CLUBSA_BOF_END] - .CCB CLUBSA_B0F_PTRJ, BSC) THEN 
> 841 1880 7 

; aes 1881 7 + ; 

; 84 135% 7 ! The field fits into the buffer, now adjust for a 

3; B44 18835 7 ! comma format character and see if the field still 

: 845 1884 7 ! fits. ra 

; 846 1885 7 : \ Will this overflow the buffer and stay within the 

; 847 1886 7 ! right margin?\ 

3; 848 1887 7 te 

> 849 1888 7 

; 850 1889 8 BEGIN 

; «851 1890 ; CHK_PRINT_ZONE 

; s26 1891 END 

; & 1336 7 ELSE 

3 6854 1895 8 BEGIN 

; «855 1338 | 

: 856 1895 '¢ ; 

: 857 1896 8 ! If LUBSV_OUTBUF_DR is true then there is other data 
; 858 1897 Hy ! in the buffer. é 

3; 859 1898 ! If SCAN_STATUS is not BASSK_CRLF (CRLF detected in record) 
; 860 1899 ; ' The buffer pointer should bé reset ‘ 

; 861 1900 ! and the other data should be dumped. If the bit is 
3 B06 1901 ' false, then this is a big string which won't all 

3; 86 190 ! fit in the buffer at once. Dump what is there and 
: He 190 ! come back for more. asd 

3 5 1904 ! If SCAN_STATUS is BASSK_CRLF then a CRLF is in the 
; 866 1905 ! string and it will fit with the other data here. 

; rt 1308 } Pretend it is all one big string. 
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CCB CLUBSV_OUTBUF_DRJ AND (.SCAN STATUS NEQ BASSK_CRLF) 
BEGIN 
'¢ 


i Set the Length back to zero so that the entire 
t. field will be scanned again 


If . 
THEN 


DSC COSCSW_LENGTH] = 0; 
He LUBSA_BUF _PTR] = .A_SAV_PTR; 


ELSE 


'¢ 
i Decrement the Length of this string which is 
- longer than one record for the next iteration 


BEGIN 
pte fits en Oe + DSC COSC$W_LENGTH); 
5 {0B eb ELEM_SIZE - “pst DSCSW. ENGTH): 
ECB COSA. BTR =".CCB CLUBSA_BUF PT .DSC CDSCSW_ LENGTH) 
“SCAN STATUS EQL BASS$K ‘CRLF THEN 3 ELSE 0); 
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END; 
.SCAN_STATUS 
END 
END; 
NEE OUTRANGE) : 0 ' this can not happen 
THEN 
'¢ 
906 5 i This element won't fit in its entirety. PUT the contents of the buffer 
st $ ! and then loop back and write the remainder. 
909 8 
910 9 BEGIN 
af ‘9 BASSSDO_WRITE (.WRITE_STATUS); 
318 26 IF (. swale STATUS EQL BASSK_COND_SUC OR .WRITE_STATUS EQL BASSK_CRLF) 
914 5 AND .L-ELEM_SIZE EQL 0 ~ 
915 54 
916 55 
917 28 BEGIN 
918 5 '¢ 
Wy 58 ! This field fit but there was not a full print zone left; the 
920 59 i format character was a comma. We want to write this record 
921 960 ' and then stort the next element on the next Line at the 
9c¢ 961 ! pete mar 
35 366 ! a CR F was found and they are the last two characters in 
924 96 : the record and we don't want to put out a null record after this 
925 964 ! record. So, bail out here. 
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Turn off the format character flag. This avoids the situation where this is the 
Last element in this 1/0 List and ends with a semicolon or comma. Even though 
‘pre’ carriage control has been set to ‘LF’, I0_BEG for the next I/0 List will 


—@ 
pe 
vw 
~_e 
~ 
a 
Ls 
ae 


! 

i 

i 

set it to null if the format character flag is on. 

CCB _CLUBSV_FORM_CHAR] = 0; 
EXITLOOP; 


END 
ELSE 
me BEGIN 
! everything fit this time. Set the buffer dirty pointer. 


CCB_CLUBS$V_OUTBUF _DR) = 1; 
ns 
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940 


6 
6 
6 
6 
6 
; 
5 
4 
4 
END; ! WHILE loop 
) 
4 
4 
; 


Free the dynamic string allocated for packed decimal conversion. 


IF .ELEM_TYPE EQL DSCSK_DTYPE_P 
STRSFREE1_DX (TEMP_DEC_DSC); 
4 


i Check for MAT PRINT. If the format character flag is not set, then this 
! matrix is being printed one element/line. Therefore it is necessary to get to 


SSSSSSSSSVSRSSeSeSS WIV INI S OSS 


the REC level and de a PUT. 
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o 
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1f (CCB CISBSB_STTM TYPE] EOL ISBSK_ST_TY_MPR) AND NOT .CCBCLUBSV_FORM_CHAR] 


S3 


BEGIN 
BASSSREC_MPR1(); 


oO 
= 


CCB CLUBSL_PRINT_POS) = 0; 
END; 


END 
UNTIL .CCB CLUBSV_AST_GUARD); ! End of AST guard loop 


Sooooooo 
ooooo 


S 
PAP 


CCB CLUBS$V_AST_GUARD] = 0; 
RETURN; 
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ND; ! End of BASSSUDF_WL1 
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4 BE 88 00008 1$: Bl 
OOF RL 
97 AB 0 A 00011 BICB2 
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. 
07FC 00000 ENTRY BASSSUDF_WL1, Save R2,R3,R4,R5,R6,R7,R3,R9,-; 1566 

SE AE 9E 00002 MOVAB -64(SP), SP : 
6 AE AB 9 0006 OVAB “Bec 4(SP) > 1648 

2 SB2 #32, a4($P ; 

STR. PTR ; 

#8, -10 o 
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34 AE dO 00380 
08 11 00384 
Oc AC 00 00386 
04 AQ 00 Q03BA 
38 AE SF OO03BE 
66 C3 003C1 
14 AE 4 003C6 
OC BE41 9F 005C9 
96 FR 8 C 

9 DO 0030 

5? €8 0030 


i 

on 
‘ee 

wo 


3 
e 
e 


p= 
p- 


= 
oe 
ww 


43$: 


51$: 


1 
19 


38e 97:82: 


} iveth Oi legate V4.0-74 
BASRTL.SRCJBASUDFWL.B32;1 


MAT_CHAR, #2 


), -76(CCB), RO 
#14 


Fr AOD 


(R7), #0, =(SP) 
14, (SPS+, RO, R 


RO, #14, R 
#0, (SPS, #32, RO, a0(R6) 


R6) 
(R7), #0, =(SP) 
14, (SP5+, RO, RO 


1$ 
#0, #16, -44(CCB), (R7) 
44$ 


#1, -95(CCB), 48$ 
(R6), =76(CCB) 


4 

L_ELEM_SIZE 

RTO, 48$ 

#14. RO 

RO 

(R7), RO 

4$ 

#3, -2(CCB), 49 
19$ 

18$ 

DSC, RO 
@-68(CCB)CROJ, (R6) 
#1, FORMAT CHAR 
L_ELEM SIZ 

#7, -95(CCB), 52$ 
#0, #16, -44(CCB), (R7) 
#8, WRITE_STATUS 


B(SP), 55$ 
MP_DEC_DSC+4, SRC_LOC 


4 
M_ADR, RO 
J, SRC_LOC 


-76(CCB), -(SP) 
M SIZ 
PTRESRC_LOC) 
CAN_TEXT 
CAN” STATU 
STATUS, 57$ 


Tie 


( 
TE 
56 
ELE 
4(RO 
DSC 
(R6) 
LEL 
aSTR 
a4, 
RO, 
SCA 
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1-077 13. 800= 1 38e tS ak BASRTL.SRCJBASUDFWL.B32;1 9 a) 
OOCE 31 00308 BRW 738 ; 
56 80 AB 9€ 00308 57$:  MOVAB ~-BO(CCB), R6 + 1889 
50 Ar C 003DF MOVZWL DSC, RO : 
ry 50 CO 00363 ADDL2 RO, (RO) : 
| SA 04 00 ES CLRL. OR : 
02 10 AC D1 OO3E CMPL - FORMAT_CHAR, #2 : 
3A 12 OO3EC BNEQ 59$ : 
| A 06 O3E INCL. R10 : 
50 B4 AB 6 C3 003F SUBL3 {R6) -76(CCB), RO : 
0€ 0 D1 003F CMPL 4 : 
OF 18 003F8 Sreou S88 : 
7E 90 C8 AB oi 7A OO3FA EMUL #1, -56(CCB), #0, =(SP) : 
50 0 BE E 78 0400 EDIV. #4, (SP)+, RO, RO ; 
50 OE 50 C3 00405 SUBL3. RO, #14, RO : 
50 20 6E 00 2C 00409 Sas: MOVCS #0. (SPS, #32, RO, a0(R6) : 
00 86 0040E : 
66 : 00 00410 MOVL 3, (R6) : 
7E 00 C8 AB 01 7A 00413 EMUL #1. -56(CCB), #0, =<(SP) : 
50 50 BE 3 78 00419 EDIV 4, (SP)+, RO, R : 
50 (8 «AB 50 ¢ O04 iE SUBL3 -56(CCB), RO ; 
(8 AB OE AO 9 004g MOVAB 14(RO), -56(CCB) : 
06 SA E8 00428 59$ BLBS R10, 66S : 
01 10 AC O01 00428 CMPL § FORMAT_CHAR, #1 : 
70 12 0042F BNEQ ; 
(8 AB D4 soAB 10 00 ED 00431 60$:  CMPZV #0, #16, -44(CCB), -56(CCB) : 
05 1E 00438 BGEQU i$ : 
29 Al AB 01 £1 0043A BBC -95(CCB), 65$ : 
B4 AB 66 D1 0043F 61S: CMPL iRé), -76(CCB) ; 
23 1A 00443 BGTRU 65$ : 
OC AE 04 00445 CLRL L_ELEM_SIZE : 
05 SA E9 00448 BLBC RTO, 62$ : 
50 OE DO 00448 MOVL #14. RO : 
02 11 0044E BRB 63$ : 
50 D4 00450 62$:  CLRL RO : 
50 C8 AB CO 00452 63$:  ADDL2 -56(CCB), RO | : 
50 D4 «AB 10 00 ED 00456 64$: CMPZV #0 rie. "-44(CCB), RO : 
43 1E 0045¢ BGEQU 71 : 
3E Al AB 01 €0 0045 BBS #1, -95(CCB), 71$ : 
50 02 DO 0046 MOVL RO : 
3C 11 00466 BRB : 
04 FE AB 03 £0 00468 65$ BBS #3, -2(CC CCB) . 66$ ; 
58 05 0046D TSTL  SAV_PRINT_POS : 
08 13 0046F BEQL  67$7 : 
38 3 B4 00471 66$:  CLRW Ds¢ : 
66 59 DO 00474 MOVL A_SAV_PTR, (R6) : 
10 11 0047 BRB 68s ; 
50 38 AE 3C 00479 67$: MOVZWL : 
66 BC BB40 9 0047p MOVAB a-é6 (Cee) CR0 (R6) : 
10 01 00 00482 MOVL RMAT ect HAR : 
OC AE D4 00486 CLRL t ret : 
OE Al AR 01 £0 00489 68$: BS eit: f. 0$ F 
(8 AB D4 sAB 10 00 €D O48E CMPZV #16, -44(CCB), -56(CCB) ; 
09 if 0495 69$:  BGEQU i: ; 
50 6 DO 00497 MOVL #6 : 
08 11 O049A BRB 72$ : 
50 08 DO 0049C 70$:  MOVL  # : 
03 11 0049F BRB 72§ ; 


ee 


OE FE 


BO 


oc 


03 04 


04 
; Routine Size: 1347 bytes, 


3; «971 2010 1 


— 


| 
BO AB 
FE 
FE 
000000006 
09 FE 
04 


F-=—mMomo 


Routine Base: 


oc 


04 
30 
FF71 


000000006 
C8 
AO 


OmMmowomnonwmno— 


FP OMOMOVMMNUIMNOOOUNPY PVP VIP MUP OMOWMO 


< 
OOwmn OS Mm ~~ 07 O09 @O-" OwW 9 "9 SS OWI MONDO 9 SOON CO @ OM Oo 9 


| 


Seno peta te eo ahh hth bh 
MNS FOVIWOS & VS VO DOOwWw™D VO FOw—-MmONSe 


POM SOON HD MNO B WY SW OODOWF (“ON OOMNNON Oo fw | OO 
m3 ~OO 


COOCCOGCOOCOCOCOCOOOCO COCO OCOCOOCOOCOCSOOCOOOOOOOOOOOOOOOOOOOOOoOO 
COOOCOCOCOOCOCCOCOCOCOCOCCOOCOCOC OOOO OCOO OOO OOOO OOCOOO OOOO OOOOOOOO 
PUPP PVPS VPVSPVSVSISISISI SIIB B* EB BB PPP PEPE PPP PPP EEE EEE 


= 
MIMD — MO OUVNVOO® 


_BASSCODE + 0030 


rom 


748: 


81$: 


74 reg Bliss-32 V4.0-74 
74 8 


ASRTL.SRC JBASUDF WL .B32;1 


#1, RO 
WRITE_STATUS 


#3, =2(CCB), 748 
SCAN. STATUS, rT 


DSC 

A_SAV_PTR, -80(CCB) 
77$ 

DSC, RO - 
RO, STR_PTR 
ost, R 

RO, L_ELEM_SIZE 


ost, 

-80(CCB), R1 
SCAN. STATUS, rt 
5$ 

#2, RO 

76$ 


RO 

RO, R1, -80(CCB) 

SCAN. STATUS, WRITE_STATUS 
WRITE_STATUS, 82$ 
WRITE-STATUS, RO 
BASSS$BO_WRITE 
WRITE_STATUS, #2 


WRITE_STATUS, #4 


L_ELEM_SIZE 
8T$ 


6$ 
#4, -2(CCB) 
3§ 


#8, -2(CCB) 
ELEM_TYPE, #21 
84$ 


TEMP_DEC_DSC 
#1, STRSFREE1_Dx 
sugsccce). #53 


5$ 
#2, -2(CCB), 85$ 
BASSSREC_MPR1 
=56(CCB) 
-96(R11), 4(SP) 


#32, a4(SP) 
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1 16-Sep-1984 11:56:4 BASRTL.SRCJBASUDFWL.832;1 (5) 


13 3 ‘i GLOBAL ROUTINE BASSSUDF_WL9 : JSB_UDF9 NOVALUE = 
(3 975 lee 
13 are ! FUNCTIONAL DESCRIPTION: 
: 978 Call the record level 1/0 end of List routine. Reset the cursor position 
: 44 if a PUT was done 
E 981 FORMAL PARAMETERS: 
: 98 NONE 
: «984 
3 i IMPLICIT INPUTS: 
; 987 LUBSV_AST_GUARD Guard for AST reentrancy 
pss 4 LUBS$V_FORA_CHAR last element transmitter ended with a format char 
4 IMPLICIT OUTPUTS: 
99 LUB$V_AST_GUARD guard for AST reentrancy 
LUBSL_PRINT_POS current cursor position 


ROUTINE VALUE: 
COMPLETION CODES: 


NONE 
SIDE EFFECTS: 


998 


This routine will loop back and reexecute if it detects that it was 
called by an AST while it was executing. 


BBE EEE EE & FANNIN 2 3 OO OS 


fale lolelejlelelelelojejlajalajlolejleoleololololelololelolololololololelelelolelelelolelelolealo) 
AE WN CO ODNOA UNE WN 0 ODNOA UNE WN 0 ODA MNES SO OONOUES WN 


Be Oe Be Be Be Be Se Oe Se Oe Be Se Be Se Se Se Fe Se Ge Oe Se Se Se Se Se Se Ge SHS Se Ge Se Se Se Se ee Se Se Se See " 
33383833 3 
Mew 
POPIPIPIPIPONPONPNYAB JPIPINININPONINPINININININININININ NP No Po Nnongnononongfnonononononononofnopononononofonopononny 
WAIN AIANII ANIA AIA AIAN NIPUDINIPNINDDY 2 9 St 2 tt 


1 

1 

1 

1 

1 

1007 BEGIN 

1008 

1009 EXTERNAL REGISTER 

13h? CCB : REF BLOCK C, BYTE); 

4 5 '¢ 

101 5 ! This outer loop is to detect an AST cailing this routine while it is 

1014 5 ! executing. 

1015 5 te 

1916 5 

101 5 

1018 05 BEGIN Sth: 2 ; 

Ha gH CCB CLUB$V_AST_GUARD] = 1; ! Initialize the guard bit 
Las :¢ 

4 32) Clear the bit which indicates an array List for MAT PRINT. 

1098 061 CCB CISBSV_MAT_PRINT] = 0; 

1024 B06 . 

106? bez Dispatch to the REC level. 

1027 065 JSB_RECO(BASSSAA_REC_PRO + .BASSSAA_REC_PRO C.CCB CISBSB_STTM_TYPE] - ISBSK_BASSTTYLO + 1)); 

10e8 508 ' Time to reset the Cursor position to Zero perhaps 


a 


vai ‘ 

3 10 0 068 
; 1031 4 
24 070 
8 i 
: 1035 $78 
; 10 074 


03 


DS 


; Routine Size: 55 bytes, 


; 1037 2075 1 


ete 


fect 4 01:38 


AX-11 Bliss-32 V4.0-74 


BASRTL.SRCJBASUDF WL .832;1 


IF NOT .CCB CLUBSV_FORM_CHAR] THEN CCB a inal Se = 0; 


END 
UNTIL .CCB CLUBSV_AST_GUARD]; 


CCB CLUBSV_AST_GUARD] = 0; 
END; 


97 


FE 


Routine Base: 


52 

52 AO AB 
62 20 
AB 04 
50 FF7)_ CB 
50 0000000060040 
0000000060040 

AB 02 
C8 =AB 

52 AO AB 
62 05 
62 20 
04 


! End of AST guard loop 


DD 00000 BASS$UDF_WL9:: 
PUSHL 


SH 
9E 00002 MOVAB 
88 00006 1$: oi 38s 
8A 00009 BICB 
9A 00000 MOVZBL 
DO 00012 MOVL 
16 QOM1A JSB 
EO 00021 BBS 
D4 00026 CLRL 
9E 00029 2$: MOVAB 
BA pongo BC 

00031 BICB2 
A 00034 POPR 
0S 00036 RSB 


-BASSCODE + 0573 


R 
=96(R11), R2 


(R 
*-105 (CCB) 
er a3ccee) RO 
BASSSAA_REC -PR9-104(ROJ, RO 
BASS$S$AA~REC =PRY CROJ 


i 


roe 


2011 
2057 


2061 
2065 
2068 
2071 


2073 
2074 


— 


r 


| 
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OF 102808= 1382 94:88:23 YEASRTL SRESBASUDFUL .639; 1 ’ (6) 
; 1039 76 1 ROUTINE SCAN_TEXT (POS, ! adr of beginning position of source strin 
; + $78 1 L H, ' Length of the oource string . 
3 1041 44 1 BUF LENGTH, ! Length of the buffer remaining 
; ok 079 #1 RET STR ! adr of where vo put the string 
; 104 080 1 ) : CALC_CCB = 
3 10464 081 1 
; 10465 0 ¢ 5 {0 
3 Hr +t ! FUNCTIONAL DESCRIPTION: 
; 1048 085 1! This routine puts a string of ASCII characters into the indicated buffer. 
: 1049 B36 1; ALL nen=pr iat ing characters, backspace, K_TAB, and corr ioge return 
; 1930 4 2: are identified in the string and their effect is reflected in the 
; 1051 » 1 internal cursor position. 
; 1326 089 1! 
3 105 090 1 ! FORMAL PARAMETERS: 
; 1054 091 1! 
; 1055 0 1! POS.rlu.r poh ay of the start of the string to output 
: 1056 095 1! LENGTH. rlu.v ength of the string to write 
; 1057 094 1! BUF __LENGTH.rlu.v Length remaining of the output buffer 
3 1928 044 : RET_STR.wt.dx pointer to descriptor for the destination 
; 1060 097 1 ! IMPLICIT INPUTS: 
; 1061 098 1! 
3 1068 2099 1! LUBSL_PRINT_POS current cursor position 
; 106 100 1! |.UBSW_R_MARGIN maximum allowable cursor position 
: 1966 19) ! LUBSA_BOF _PTR current position in the buffer 
3 1066 108 1 ! IMPLICIT OUTPUTS: 
; 1067 1046 1! 
3; 1068 103 6} (6 LUBSL_PRINT_POS current cursor position 
: 1069 106 1! 
: 1070 2107 1 ! ROUTINE VALUE: 
: 1071 2108 1! 
; 44 2109 1! BASSK_MAR_EXC right margin exceeded 
3 107 2110 1! BAS$K_CRLF embedded CRLF in the record 
; 1074 robb ee ee BASS$K_SUCCESS successful completion 
; 1075 M6 ,} 
3; 1076 113° 1°! SIDE EFFECTS: 
; 1077 1144 1! 
: 1078 2115 1! NONE 
; 1079 2116 1! 
; 1080 2117 1 !-= 
; 1081 118 #1 
3 1 119 BEGIN 
: 108 120 
: 1084 121 P 
: 1085 1 ; POS : REF VECTOR C, BYTE], 
; Hi : ? RET_STR : REF BLOCK (8, BYTE]; 
: 1088 125 EXTERNAL REGISTER 
; 1089 1 $ CCB : REF BLOCK C, BYTE); 
3; 1090 1 
3; 1091 128 LITERAL 
: 44 129 K_STOP = a ! stop or escape character for MOVTUC 
; 109 130 K_TILDE = 2x'7E", ! tilde character 
3 1094 131 K-LF = %x'OA' ! Line feed character 
; 1095 132 K_BKSP = 1x'08", ! backspace character 


Re ciate 9 aR al SE ts ek a 


-— 
i 


Be 1:88:45 EBASRT oSaeSeasupruL -039;1 small 


3; 1 133 K_TAB = %x'09', tab character 

: 1999 134 K-CR = &x'OD' carriage return character 

; 1098 135 KIBLANK = %Xx'20' ! blank character 

; 1099 1 6 KITAB_LIT = %X'0?"; 

; 1100 1 

3 1101 138 BIND 

5 1196 139 ESC = UPLIT BYTE(K_STOP), 

; 110 140 

3 11046 141 '¢ 

; 1105 106 ! This translation table is used for a MOVTUC instruction. It trans- 

3 1198 14 ' Lates all normal 7 bit rsomanerses into themselves and stops on 

3 ey 24 1¢2 : characters which affect the cursor position (backspace, tab, and CR). 

: 1109 146 

3 1110 147 TRANS _TABLE = UPLIT BYTE(2x"00" %x"00" %x°00" %x°00? . ZX°00", 2x°OO", 2x°O0", 2KX°OO", 2x°OO", &¥ 
31111 148 "O00", 2x'00', 2x°00", Zx°00', Xx'OO', Zx'00', 2x00 ! column 

: 1118 149 xx'o6', 2x06", xx'od', xx'06", 2x06", 2x'06", ax'0b", 2x"00", %x°00", 2x00", 2x00", %x"00", 
3111 150 ZX"O0", Zx"OO", 2x° a 2x'OO', ' column 

3.1116 151 ZX°20", ZK°27", AUK*22", WK2N5", AK26", AK'25*, WK'26", AK'27", BK'2B", A299", AX*2A", AX°2B", 
3 1115 136 ZX'2C°, ZX°2D", Ix* oe Zx'2F', ' column 2 

3; 1116 15 ZX°SO", ZK°S1", WK°S2°, BK°S3", AM'S4", WK'S5*, AK°S6", AN'S7", AN'SB", WK'S9", AN'SA", Ix'3B", 
3 1117 154 Bn’ Ss BA aes an Be Zx'SF*, ' column 3 

3; 1118 155 RX'GO", BX°G1", BK°G2", AKG", AK'GG", WX'4S", BK'46", BX'47", BK4B', ANGI", AX'GAS, BKB", 
3 1119 156 ZX°SC*, ZX'°4D', a ZX'4F*, ' column 4 

; 1120 157 ZX°5O°, ZK°S1", BK°S2°, WK°S3", AK°S56", BK°S5*, WK°56", AK'S7*, BK'5B", BX°59", AN*SA*, 2X°SB", 
3 1121 158 ZX°5C*, 2x"5D°, a oe ae a ' column 5 

$ 1156 159 ZX°60", ZX°61', 2X62", BK°SS", BK'S4", BWK'6S*, WK°66", IX°67", BK°6B", BK°69", ZX'GA", ZX°6B", 
3 11e 2160 ZX*6C*, ZX*6D", AX°6E*, BX'SF', ' column 6 

3 1126 2161 ZX°70", EX°71", AK72", AK73", AK74", BAN'75*, AX'76", B'77", B78", B79", AX*7A", BX'7B", 
3 3129 sio¢ B°va*s Bete 6 Be tes BOs ' column 7 

: 1126 216 ZX°OO", Zx°O00", Zx°O0", Zx°O00", 2K°O0", ZX°OO", AK°OO", AK*OO", IK*OO", WOO", Lx*O0", Fx"O0', 
3 1127 2164 $ x'00", £x'00", 2x'00", £x'00', ' column 8 

3: 1128 2165 "00", £x°OO", 2x°O0", ZKX°00", ZxX°OO", ZX'OO', AK'OO", AK*OO", AK"OO", AK°OO", K*OO", &x'OO", 
: 1163 $166 2 ZxX'0O", 2x'00', "00", £x‘O0', ' column 9 

; 1130 167 2 Zx"AO', ZX°A1", ZK*A2", ZK*AS", AK'AG', AZX°AS', AZK°AG", AZX'A7", ZK°ABS, AK"AS", AK°AAS, ZX°AB, 
3 1131 5168 2 X"AC', ZX°AD', "AE’, ZX°AF', ' column 

3; 1132 169 2 x"BO', ZX"BI', *"B2', 2X°B3S", %X°B4", ZX"BS*, 2X°B6", 2X°B7", ZX°BB", ZX'B9", ZX"BA', ZX'BB', 
3; 1135 2170 "BC’, ZX°BD', ZX"BE*, IX'BF’, ' column 1 

3 1134 171 M"CO", ZX°C1", ZBx°C2", BX°CS", BKC", AMCS*, AKC", AMC7*, ACB", ACH", AMCA*, ZK°CB", 
3 1135 7¢ *cr*, Bn Ces Ba Gk s Be’ Urs ' column 

3; 1136 17 "DO", ZX'D1", ZX"D2", EX'D3", AK°D4", AX'DS*, AX'DS*, AK'D7", AX'DB*, ZX'D9*, AX"DA, 2X"DB’, 
3; 1137 size X"DC’, ZX°DD*, ZX°DE*, AX'OF', ' column 

; 1138 te Te "EO’, ZX"E1", ZK°E2*, AK°ES', AK"ES*, AMES", ZX°ESG", AX'E7*, ZK"EB’, AXED’, AM*EA’, IK°EB', 
3; 1139 176 X"EC’, ZX°ED', a 2X'EF', ' column 

3; 1140 17 "FO", 2X°F1", ZX°F2]", ZX°F3*, AM°FG", ZX°FS*, AX'FG", AXF7*, AMFB’, AXED", AKFA*, AX'FB, 
> 1141 178 X°FC'. EX"FD'. ZX"FE*, ZX°00'S ' column 15 

1148 179 VECTOR (256, BYTE); 

3 114 180 

3 1166 181 LOCAL 

3 1145 1 § L_SAVE_LENGTH, ' save Length of string scanned so far 

3 1146 1? DEST LENGTH, ' Length of destination buffer 

3 1147 1 SRC_CENGTH, ' Length of source string 

3 1148 185 A_SAVE_BuF PTR : | to save LUBSA_BUF PT 

> 1149 1 T~DSC = BLOCK (8, Byte), i working desc to hold the fourth argument 

3 1150 1 ERD_POS, ' no. of characters in source string + current 

3; 1151 188 ! address in the buffer Re 

3 1152 189 L_SAV_PRINT_POS, ! temp to save the cursor position 
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-1984 01:23:4 AX-11 Bliss-32 V4.0-74 Pa 31 
pr1086 fisseres 3.1 % 6) 
} in case the right margin is exceeded 
i 
; 
! 


os local to hold readonly arg. POS 
RET_VAL, the status value returned to the caller. 
MOV_VAL receives the returned status from MOVTUC 
T BOF PTR temp buffer ptr, to ogree with print pos 
ORIG_GuF _PtR; another buf ptr, unmodified so 


LUBSA_BUF _PTR can be restored 


' 
! Save off a number of pointers. We will not overflow the buffer because 

! the MOVTUC which is used to load the buffer has a destination length operand, 
! however it is possible to exceed the right margin if there are one or more 

! TAB characters. If the margin is exceeded, it is detected in the macro 

' CHK_CURSOR_POS, then the oct ing is backed up and each character is moved 

' untTl the fon margin is reached. Normally, if an element does not fit 

! into the buffer, the buffer is dumped without it. However, there is the 

! case where a string is longer than the buffer and must be put out in seg- 
ments. That is not to be decided in this routine. 


DEST_LENGTH = .BUF_LENGTH; 

SRC_CENGTH = .LENGTH; 

pur PTA o CCB CLUBSA.BUF_PTRI 
=. Ld 

ORIG _BuF_PTR = CB ELUBSA BUF PiR): 

T_pst 1=0 

T~DSC a 

ERND_POS = MINU (.SRC_LENGTH,~.DEST_LENGTH) + .T1_POS; 

MOV-VAL = 1; 


'¢ 
! This loop will find all of the cursor position affecting characters in 
the string. 


WHILE gMOV_VAL NEQU 0 DO 


RET_VAL = (IF .DEST_LENGTH GEQ .SRC_LENGTH THEN BASS$K_SUCCESS ELSE BASS$K_BUF _EXC); 
A_SAVE_BUF_PTR = .T-BUF_PTR; 

LSAV_PRINT_POS = .CCB FLupé. PRINT POS); 

L-SAVE_LENGTH = .T_DSC COSCSW"LENGTA); 

MOv_VAC = MOVTUC (SRC_LENGTH, .T_POS, ESC, TRANS_TABLE, DEST_LENGTH, .T_DSC CDSCSA_POINTER]); 
' 


¢ 

! Set RET_VAL to either 1 (success) or 0 (failure) based on whether 
! there was enough room in the buffer for the entire translated 

' string. A value of 1 at this point may be changed in the macro 
CHK_CURSOR_POS. 


IF .MOV_VAL EQLU 0 
THEN 


'¢ 
! MOVTUC was able to move the entire source string without encountering 
! an ‘escape’ character. Update the cursor position and check to 

! see if it exceeds the right margin. 


wear a 


BA F WL 
BAS5Hr 
; 1 
BEGIN 
: SWITCHES LIST (EXPAND); 
T_DSC COSCSW_LENGTH] = .1_DSC_CDSC$W_LENGTH 
CCB CLUBSL_PRINT POS] = .CCB CLUBSL_PRINT_P 
BuF = .T_BOF_PTR + .SRC_LENGTA; 
CAK_CORSOR_POS; 
ELSE 
BEGIN 
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! an ‘escape’ character was detected in the 
! increment the cursor position for the sub 
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to keep up with the cursor position. 
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“BUF _PTR = .1_.B +. = TP 
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: Check for an occurrence of a CRLF which will delimit 
the LF is included in the buffer. 


\¢ 
We should do a LSSU instead of LEQU, to fix 1-065D. 


IF .(.MOV_VAL)<O, 8> EQL K_CR 
AND .TMOV_VAL) + 1 LSSO .POS + .LENGTH 
AND .(.(MOV_VAL) + 1)<0, 8> EQL K_LF 


THEN 
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and return the fact that a delimiting CRLF was found. 
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CAK_CURSOR_POS; 
RET-VAL = BASSK_CRLF; 
EXITLOOP; 

END 
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i escape’ character was not CR followed by 
to reset PRINT_POS for CRLF because it is 
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source string. 
string moved plus one 


! for the ot vending, cherecter. the buffer pointer must be moved 


OS] + (.MOV_VAL = .T_POS); 


+ 1; 
] + (.MOV_VAL = .T_POS) *# 1; 


the record and insure that 


! There is a CRLF in this record. Set the length properly to include the CRLF 


DSC CDSC$W_LENGTH) = .T_DSC COSCSW_LENGTH) + 1; 


+ 
Adjust the cursor position for the ‘escape’ character if the 


LF. We don't want 
a complete record 


and must be evaluated as such for both comma zone formatting and 


CCB CLUBSL_PRINT_POS] = (SELECTONE .(.MOV_VAL)<O, 8, 0> OF 
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OD iF 0027F 
51 91 00281 
07 1A 00285 
01 ¢1 00287 
04 11 0028C 
10 BE DO 0028E 
50 00 00292 
1¢ BE 06 00296 
24 «AE Bb 00299 
AB 11 0029C 
08 AE 00 0029E 
14 AE 00 002A3 
24 AE BO 002A8 
AE 00 002AD 
04 00281 


_BASSCODE + 06AB 


36$: 


37$: 


38$: 


4 #16, -44(CCB), a16(SP) 


Cn SAV “LENGTH 1*68c 
av, ‘bs . 438 
“9 #16, -44(CCB), a16(SP) 
@28(SP), RO 
(RO), Ri 
#9 
37 
#7, @16(SP), RO 
RO 
41$ 
R1, #13 
38$ 
Ri, #8 


39 
#1, al6(SP), RO 
41$ 


RO 
41$ 

RI #32 

R1, #126 

#1, al6(SP), RO 
41$ 

a16(SP), RO 

RO, al6(SP) 
a28(SP) 

T DSC 

36$ 

A_SAVE_BUF_PTR, @28(SP) 
ORIG BOF PTR, 828(SP) 


TDSC, a@RET_ST 
RET_VAL, RO 


223: ere Bliss-32 V4.0-74 
256:4 BASRTL.SRCIJBASUDFWL.B32;1 


Be Se Se Se Se Se Be Se Be Be Be Se Se Se Se Be Se Se Se Fe Se Se Be Se Fe Se Fe Fe Se Se Se Be Se Se Se Be Ge Be Be Se 


Page 37 
(6) 


dD 4 
he i, sae Ve=$ep-1986 11:56:63 EBASRTL SRESBASUDF AL .039; 1 
| et voreee) 1? —wanmencriad: ! Write one record with indicated carriage control 
| o ) : JSB_DO_WRITE NOVALUE = 
04 ae 
05 FUNCTIONAL DESCRIPTION: 


PND 2 2 a OO 


WAWWWronononofnonof 
WN $9 CONOAVUEWN SO ODNAVE WN OOM 


AAAI AINA AIA AANA tw 
FEFES AS 


ESEEE 


ee ee ee ee ee ee ee ee ee eee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ees 
m=O 0COnNOu 


Www 
ww 


SS 
Bete ee Oe Be Be ee Oe Oe Be Oe Oe Se Se Se Se Be Se Ge Se Se Ge Se Ge Ge Ge Se Ge Ge G. Se SH Ge Se Ge OH Se Se oe HSH Se Se Oe SHS Hee Se Geese 


This routine centralizes calls to the record level write routine. A 
few vlues in the data base are reset. 


' 

i 

FORMAL PARAMETERS: 

CARRIAGE _CTRL.rlu.v indicates whether to insert CRLF or leave the cursor 
IMPLICIT INPUTS: 

ccB address of current control block 

IMPLICIT OUTPUTS: 
i 

! 

i 

i 

i 

i 

i 

i 

i 

i 

i 
ie 


LUBS$V_OUTBUF _DR indicates valid data in the output buffer 
LUBSL_PRINT_POS current cursor position 


COMPLETION CODES: 
NONE 
SIDE EFFECTS: 
NONE 
BEGIN 


EXTERNAL REGISTER 
CCB : REF BLOCK C, BYTE); 


BASSSREC_WSL1 (.CARRIAGE_CTRL); 


'¢ 
: Reset the output buffer dirty bit 
—— 
! Reset the cursor position only if a record was written. Otherwise, the 


! cursor was left at the end of the data written and the cursor position 
is still valid 


IF .CCB CLUBSA_BUF_PTR] EQL .CCB CLUBSA_BUF_BEG] THEN CCB CLUBSL_PRINT_POS] = 0; 
CCo LLUBSY_OUTBUF DR) = 0; 


END; 


CNOA UE WW CO OONOA UNE WP 0 ODNO UNE WR 0 OOO NEW — ODO ENOU ESA" ODOOno 
= PROPROPOPOPONONIPONOPONONONININPONININIDD 2 St 9 


o> 00 09 00 CD GD CD 


—@Dw 


Elapsed Time: 02:1 
Lines/CPU Min: 241 
ema Ae Rigi? 26343 
poet | Used: 609 pages 
Compilation Complete 


eal 


4 

| BASSSUDF _WL 1s ep-1984 01: AX-11 Bliss-32 V4.0-74 

1-077 188871986 91 :$8:4 BASRTL SRCIBASUDFUL 63951 
| 000000006 00 16 00000 BASSS$DO_WRITE:: 
JSB BASSSREC_WSL1 : 

BC AB BO ag D1 00006 CMPL =-80(CCB)> =-68(CCB) 3 

03 12 00008 BNEQ 3 ; 
c8 ae 4 0000D CLRL -56(CCB) : 
FE AB 0 A 00010 1$: BICB2 #8, -2(CCB) : 
0014 RSB i 
E Routine Size: 21 bytes, Routine Base: _BASSCODE + 095D 

: 1353 89 1 

3; 1354 90 1 END 

; 1355 91 #1 

; 1356 392 0 ELUDOM 

; PSECT SUMMARY 

: Name Bytes Attributes 

: _BASSCODE 2418 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 

; Library Statistics 

; fies (SO ea i Symbols -------- Pages Processing 

: File Total Loaded Percent Mapped Time 

: _$255$DUA28:(SYSLIBISTARLET.L32;1 9776 14 0 581 00:01.1 

; COMMAND QUALIFIERS 

; BLISS/CHECK=(FIELD, INITIAL,OPTIMIZE) /NOTRACE/LIS=LIS$:BASUDFWL/OBJ=OBJ$:BASUDFWL MSRC$:BASUDFWL/UPDATE=(ENHS : BASUDF WL ) 

; Size: 2161 code + 257 data bytes 

Run Time: 00 73° 4 

| 
| 
| 


3383 
3388 


— 


ENT CORPORATION 
ND PROPRIETARY 


003 AH-BT13A-SE - | | PM 
\ VAX/VMS V4.0 A 


